home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / R-Shows / (c)sds.d64 / sprite edit.c (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  6KB  |  168 lines
  1. 100 REM MULTI-COLOUR SPRITE EDITOR
  2. 110 REM BY PAUL HIGGINBOTTOM
  3. 120 REM
  4. 130 IF LF=1 GOTO 6550
  5. 1000 V=13*4096:CR=13*4096+8*256
  6. 1005 C0=0:C1=1:C2=2:C3=3:C4=4:C5=5:C6=6:C7=7:C8=8:C9=9
  7. 1010 SC=1024:SD=SC+1016:PM=64:LL=40:SP=0:LL=40:MD=0
  8. 1020 POKE V+32,0:POKE V+33,0:POKE V+17,27+64:POKE V+37,2:POKE V+38,5
  9. 1030 FOR I=0 TO 7:POKE SD+I,192+I:POKE V+39+I,C8+I
  10. 1060 A(I)=C2^I:B(I)=255-A(I)
  11. 1070 NEXT
  12. 1080 POKE V+21,C0:POKE V+28,255
  13. 1090 FOR I=0 TO 3:C(I)=A(I*C2)+A(I*C2+C1):D(I)=255-C(I):E(I)=A(I*C2):NEXT
  14. 1210 MX=11:NX=12:MY=20:NY=21
  15. 1220 POKE 650,128:GOSUB 8100
  16. 1300 FOR I=0 TO 3:Q=I*C2:X(Q)=243:Y(Q)=70+I*30:X(Q+C1)=270:Y(Q+C1)=70+I*30:NEXT
  17. 1310 FOR SP=0 TO 7:GOSUB 7700:NEXT
  18. 1320 OPEN 1,8,15
  19. 1400 IP=20:REM INPUT POSITION
  20. 1410 IB$="                   ":REM INPUT BLANKING STRING
  21. 1900 POKE V+21,1:SP=0
  22. 2000 PRINT "[159][147]";
  23. 2010 FOR I=0 TO 20:PRINT SPC(24)"*":NEXT
  24. 2020 PRINT "************************"
  25. 2030 PRINT "COLOURS:  :  :  :[145]"
  26. 2090 FOR I=1 TO 3:Q=SC+925+I*C3:R=32+I*64:POKE Q,R:POKE Q+C1,R:NEXT
  27. 2100 GOSUB 9000
  28. 2120 PG=PEEK(SD+SP)
  29. 2130 P=PG*PM
  30. 2140 POKE 247,SP
  31. 2150 SYS MC
  32. 2600 PRINT "SPRITE    [157][157][157][157]"SP"[157], PAGE    [157][157][157][157]"PG
  33. 3000 R=SC+Y*LL+X*C2:T=PEEK(R)
  34. 3010 S=PEEK(R)
  35. 3020 S=(S+64)AND 255
  36. 3030 POKE R,S:POKE R+1,S
  37. 3040 FOR I=1 TO 25:GET A$:IF A$="" THEN NEXT:GOTO 3020
  38. 3050 POKE R,T:POKE R+1,T
  39. 3090 IF A$<>"" GOTO 3110
  40. 3100 X=X+C1+NX*(X=MX):IF X=C0 GOTO 3125
  41. 3105 GOTO 3000
  42. 3110 IF A$="[157]" THEN X=X-C1-NX*(X=C0):GOTO 3000
  43. 3120 IF A$<>"" GOTO 3130
  44. 3125 Y=Y+C1+NY*(Y=MY):GOTO 3000
  45. 3130 IF A$="[145]" THEN Y=Y-C1-NY*(Y=C0):GOTO 3000
  46. 3140 IF A$<"1" OR A$>"4" GOTO 3300
  47. 3150 C=VAL(A$)-C1
  48. 3160 R=P+Y*C3+X/C4:Q=PEEK(R):BP=C3-(X AND C3):Q=(Q AND D(BP)) OR C*E(BP)
  49. 3165 POKE R,Q
  50. 3170 R=SC+Y*LL+X*C2:C=C*64+32
  51. 3180 POKE R,C:POKE R+C1,C
  52. 3190 GOTO 3100
  53. 3300 IF A$<>"X" GOTO 3320
  54. 3310 Q=A(SP):W=PEEK(V+29):W=(W AND NOT Q) OR (NOT W AND Q):POKE V+29,W:GOTO3000
  55. 3320 IF A$<>"Y" GOTO 3340
  56. 3330 Q=A(SP):W=PEEK(V+23):W=(W AND NOT Q) OR (NOT W AND Q):POKE V+23,W:GOTO3000
  57. 3340 IF A$<>"+" GOTO 3370
  58. 3350 PG=PG+C1
  59. 3360 POKE SD+SP,PG:GOTO 2100
  60. 3370 IF A$="-" AND PG>192 THEN PG=PG-C1:GOTO 3360
  61. 3380 IF A$<>"N" GOTO 3390
  62. 3385 SP=(SP+C1) AND C7:GOTO 3400
  63. 3390 IF A$<>"P" GOTO 5000
  64. 3395 SP=(SP-C1) AND C7
  65. 3400 POKE V+21,PEEK(V+21) OR A(SP):GOTO 2100
  66. 5000 IF A$="[133]" THEN POKE V+33,(PEEK(V+33)+1)AND 15:GOTO 7000
  67. 5010 IF A$="[134]" THEN POKE V+37,(PEEK(V+37)+1)AND 15:GOTO 7000
  68. 5020 IF A$="[135]" THEN POKE V+39+SP,(PEEK(V+39+SP)+1)AND 15:GOTO 7000
  69. 5030 IF A$="[136]" THEN POKE V+38,(PEEK(V+38)+1)AND 15:GOTO 7000
  70. 5040 IF A$="[147]" THEN FOR I=0 TO 63:POKE P+I,0:NEXT:GOTO 2100
  71. 5050 IF A$="" THEN FOR I=0 TO 63:POKE P+64+I,PEEK(P+I):NEXT:GOTO 3350
  72. 5060 IF A$<>"C" GOTO 5100
  73. 5070 P$="TO WHICH PAGE?":GOSUB 8200:IF I$="" GOTO 3000
  74. 5080 IF Q=0 GOTO 7910
  75. 5090 FOR I=0 TO 63:POKE Q*64+I,PEEK(P+I):NEXT:PG=Q
  76. 5095 P$="NOW AT NEW PAGE":GOSUB 8400:GOTO 3360
  77. 5100 IF A$<>"    " GOTO 5130
  78. 5110 FOR I=P+60 TO P STEP -1:POKE I+C3,PEEK(I):NEXT
  79. 5120 FOR I=0 TO 2:POKE P+I,0:NEXT:GOTO 2100
  80. 5130 IF A$<>"" GOTO 5160
  81. 5140 FOR I=P+3 TO P+63:POKE I-C3,PEEK(I):NEXT
  82. 5150 FOR I=61 TO 63:POKE P+I,0:NEXT:GOTO 2100
  83. 5160 IF A$=";" THEN X(SP)=(X(SP)+C1) AND 511:GOSUB 7700:GOTO 3000
  84. 5170 IF A$=":" THEN X(SP)=(X(SP)-C1) AND 511:GOSUB 7700:GOTO 3000
  85. 5180 IF A$="@" THEN Y(SP)=(Y(SP)-C1) AND 255:GOSUB 7700:GOTO 3000
  86. 5190 IF A$="/" THEN Y(SP)=(Y(SP)+C1) AND 255:GOSUB 7700:GOTO 3000
  87. 6000 IF A$<>"S" GOTO 6500
  88. 6010 P$="FROM WHICH PAGE?":GOSUB 8200:IF I$="" GOTO 3000
  89. 6020 FP=Q:IF Q=0 GOTO 7910
  90. 6030 P$="TO WHICH PAGE?":GOSUB 8200:IF I$="" GOTO 3000
  91. 6040 LP=Q:IF Q=0 GOTO 7910
  92. 6045 IF LP<FP GOTO 7940
  93. 6050 P$="<D>ATA,<S>RC,<P>RG?":GOSUB 8200:IF I$="" GOTO 3000
  94. 6060 IF (I$<>"S") AND (I$<>"P") GOTO 7920
  95. 6065 IF I$="S" GOTO 6200
  96. 6070 GOSUB 8500:IF I$="" GOTO 3000
  97. 6080 OPEN 2,8,1,I$:GOSUB 7800:IF P$<>"OK" GOTO 7990
  98. 6085 P$="SAVING - WAIT":GOSUB 8400
  99. 6090 Q=FP*PM:PRINT#2,CHR$(Q-INT(Q/256)*256)CHR$(Q/256);
  100. 6100 FOR I=Q TO LP*PM+63:PRINT#2,CHR$(PEEK(I));:NEXT
  101. 6110 CLOSE2:P$="DONE":GOTO 7990
  102. 6200 GOSUB 8500:IF I$="" GOTO 3000
  103. 6210 OPEN 2,8,2,I$+",S,W":GOSUB 7800:IF P$<>"OK" GOTO 7990
  104. 6220 P$="WRITING SOURCE...":GOSUB 8400
  105. 6230 Q=FP*PM:C=LP*PM+63
  106. 6240 PRINT#2,";SPRITE DATA":PRINT#2,";"
  107. 6250 FOR I=Q TO C STEP 8:PRINT#2,".BYT ";
  108. 6260 FOR J=0 TO 7:PRINT#2,MID$(STR$(PEEK(I+J)),C2);:IF J<>C7 THEN PRINT#2,",";
  109. 6270 NEXT:PRINT#2:NEXT:PRINT#2,";":PRINT#2,".END":GOTO 6110
  110. 6500 IF A$<>"L" GOTO 6600
  111. 6510 GOSUB 8500:P$="LOADING - WAIT":GOSUB 8400
  112. 6540 LF=1:LOAD I$,8,1
  113. 6550 GOTO 2000
  114. 6600 IF A$="O" THEN POKE V+21,PEEK(V+21) AND B(SP):GOTO 3385
  115. 6900 GOTO 3000
  116. 7000 GOSUB 9000:GOTO 3000
  117. 7700 REM SET SPRITE POSITION
  118. 7710 POKE V+SP*C2,X(SP) AND 255:Q=PEEK(V+16) AND B(SP)
  119. 7720 IF X(SP)>255 THEN Q=Q OR A(SP)
  120. 7730 POKE V+16,Q:POKE V+SP*C2+C1,Y(SP)
  121. 7760 RETURN
  122. 7800 INPUT#1,A$,P$,A$,A$:RETURN
  123. 7900 REM ERROR OUT
  124. 7910 P$="LESS THAN 192":GOTO 7990
  125. 7920 P$="NOT IMPLEMENTED":GOTO 7990
  126. 7930 P$="SAY WHAT?":GOTO 7990
  127. 7940 P$="TO<FROM!":GOTO 7990
  128. 7990 GOSUB 8400:GOTO 3000
  129. 8000 DATA 169,0,133,248,133,251,169,4,133,249,166,247,189,248,7
  130. 8010 DATA 133,250,160,6,6,250,38,251,136,208,249,169,21,133,254
  131. 8020 DATA 169,0,133,253,164,253,192,3,208,27,24,165,248,105,16
  132. 8030 DATA 133,248,144,2,230,249,24,165,250,105,3,133,250,144,2
  133. 8040 DATA 230,251,198,254,208,220,96,177,250,133,247,169,3,133,252
  134. 8050 DATA 162,0,6,247,144,2,232,232,6,247,144,1,232,169,32
  135. 8060 DATA 224,0,240,6,24,105,64,202,208,250,160,0,145,248,200
  136. 8070 DATA 145,248,24,165,248,105,2,133,248,144,2,230,249,198,252
  137. 8080 DATA 16,209,230,253,208,164,-1
  138. 8100 MC=4*4096:M=MC:NE=-1
  139. 8102 READ A,B:IF PEEK(MC)=A AND PEEK(MC+C1)=B THEN RETURN
  140. 8105 RESTORE
  141. 8110 READ A:IF A<>NE THEN POKE M,A:M=M+C1:GOTO 8110
  142. 8120 RETURN
  143. 8200 REM INPUT ROUTINE
  144. 8210 GOSUB 8400:PRINT SPC(IP):I$=""
  145. 8220 F=0
  146. 8230 PRINT "*[157]";:GOTO 8250
  147. 8240 PRINT " [157]";
  148. 8250 FOR I=1 TO 30:GET A$:IF A$="" THEN NEXT:F=C1-F:ON F+C1 GOTO 8230,8240
  149. 8260 IF A$=CHR$(20) AND I$="" GOTO 8250
  150. 8270 IF A$=CHR$(20) THEN I$=LEFT$(I$,LEN(I$)-C1):PRINT A$;:GOTO 8220
  151. 8280 IF A$<>CHR$(13) GOTO 8320
  152. 8290 PRINT ""SPC(IP)IB$
  153. 8300 PRINT SPC(IP)IB$:Q=0:IF VAL(I$)>191 THEN Q=VAL(I$)
  154. 8310 RETURN
  155. 8320 IF A$<" " OR A$>"Z" GOTO 8220
  156. 8330 IF LEN(I$)<10 THEN I$=I$+A$:PRINT A$;
  157. 8340 GOTO 8220
  158. 8400 REM PROMPT
  159. 8410 PRINT ""SPC(IP)IB$:PRINT "[145]"SPC(IP)P$:RETURN
  160. 8500 REM INPUT FILENAME
  161. 8510 P$="FILENAME?":GOSUB 8200:RETURN
  162. 8999 END
  163. 9000 REM (null) SPRITE COLOURS INTO EXTENDED COLOUR MODE REGISTERS
  164. 9010 POKE V+34,PEEK(V+37)
  165. 9020 POKE V+35,PEEK(V+39+SP)
  166. 9030 POKE V+36,PEEK(V+38)
  167. 9040 RETURN
  168.